home *** CD-ROM | disk | FTP | other *** search
/ Gigarom 1 / Gigarom Macintosh Archives (Quantum Leap)(CDRM1080320)(1993).iso / FILES / DEV / I-Z / Xlisp_Source.cpt / xlio.c < prev    next >
Text File  |  1985-04-09  |  3KB  |  153 lines
  1. /* xlio - xlisp i/o routines */
  2.  
  3. #include "xlisp.h"
  4.  
  5. /* external variables */
  6. extern int xlplevel;
  7. extern int xlfsize;
  8. extern NODE *xlstack;
  9. extern NODE *s_stdin,*s_stdout;
  10. extern int xldebug;
  11. extern int prompt;
  12. extern char buf[];
  13.  
  14. /* xlgetc - get a character from a file or stream */
  15. int xlgetc(fptr)
  16.   NODE *fptr;
  17. {
  18.     NODE *lptr,*cptr,*ofptr;
  19.     FILE *fp;
  20.     int ch;
  21.  
  22.     /* check for input from nil */
  23.     if (fptr == NIL)
  24.     ch = EOF;
  25.  
  26.     /* otherwise, check for input from a stream */
  27.     else if (consp(fptr)) {
  28.     if ((lptr = car(fptr)) == NIL)
  29.         ch = EOF;
  30.     else {
  31.         if (!consp(lptr) ||
  32.         (cptr = car(lptr)) == NIL || !fixp(cptr))
  33.         xlfail("bad stream");
  34.         if (rplaca(fptr,cdr(lptr)) == NIL)
  35.         rplacd(fptr,NIL);
  36.         ch = cptr->n_int;
  37.     }
  38.     }
  39.  
  40.     /* otherwise, check for a buffered file character */
  41.     else if (ch = fptr->n_savech)
  42.     fptr->n_savech = 0;
  43.  
  44.     /* otherwise, get a new character */
  45.     else {
  46.  
  47.     /* get the file pointer */
  48.     fp = fptr->n_fp;
  49.  
  50.     /* prompt if necessary */
  51.     if (prompt && fp == stdin) {
  52.  
  53.         /* print the debug level */
  54.         ofptr = s_stdout->n_symvalue;
  55.         if (xldebug)
  56.         { sprintf(buf,"%d:",xldebug); xlputstr(ofptr,buf); }
  57.  
  58.         /* print the nesting level */
  59.         if (xlplevel > 0)
  60.         { sprintf(buf,"%d",xlplevel); xlputstr(ofptr,buf); }
  61.  
  62.         /* print the prompt */
  63.         xlputstr(ofptr,"> ");
  64.         prompt = FALSE;
  65.     }
  66.  
  67.     /* get the character */
  68.     if (((ch = getc(fp)) == '\n' || ch == EOF) && fp == stdin)
  69.         prompt = TRUE;
  70.  
  71.     /* check for input abort */
  72.     if (fp == stdin && ch == '\007') {
  73.         xlputc(ofptr,'\n');
  74.         prompt = TRUE;
  75.         xlabort("input aborted");
  76.     }
  77.     }
  78.  
  79.     /* return the character */
  80.     return (ch);
  81. }
  82.  
  83. /* xlpeek - peek at a character from a file or stream */
  84. int xlpeek(fptr)
  85.   NODE *fptr;
  86. {
  87.     NODE *lptr,*cptr;
  88.     int ch;
  89.  
  90.     /* check for input from nil */
  91.     if (fptr == NIL)
  92.     ch = EOF;
  93.  
  94.     /* otherwise, check for input from a stream */
  95.     else if (consp(fptr)) {
  96.     if ((lptr = car(fptr)) == NIL)
  97.         ch = EOF;
  98.     else {
  99.         if (!consp(lptr) ||
  100.         (cptr = car(lptr)) == NIL || !fixp(cptr))
  101.         xlfail("bad stream");
  102.         ch = cptr->n_int;
  103.     }
  104.     }
  105.  
  106.     /* otherwise, get the next file character and save it */
  107.     else
  108.     ch = fptr->n_savech = xlgetc(fptr);
  109.  
  110.     /* return the character */
  111.     return (ch);
  112. }
  113.  
  114. /* xlputc - put a character to a file or stream */
  115. xlputc(fptr,ch)
  116.   NODE *fptr; int ch;
  117. {
  118.     NODE *oldstk,lptr;
  119.  
  120.     /* count the character */
  121.     xlfsize++;
  122.  
  123.     /* check for output to nil */
  124.     if (fptr == NIL)
  125.     ;
  126.  
  127.     /* otherwise, check for output to a stream */
  128.     else if (consp(fptr)) {
  129.     oldstk = xlsave(&lptr,NULL);
  130.     lptr.n_ptr = newnode(LIST);
  131.     rplaca(lptr.n_ptr,newnode(INT));
  132.     car(lptr.n_ptr)->n_int = ch;
  133.     if (cdr(fptr))
  134.         rplacd(cdr(fptr),lptr.n_ptr);
  135.     else
  136.         rplaca(fptr,lptr.n_ptr);
  137.     rplacd(fptr,lptr.n_ptr);
  138.     xlstack = oldstk;
  139.     }
  140.  
  141.     /* otherwise, output the character to a file */
  142.     else
  143.     putc(ch,fptr->n_fp);
  144. }
  145.  
  146. /* xlflush - flush the input buffer */
  147. xlflush()
  148. {
  149.     if (!prompt)
  150.     while (xlgetc(s_stdin->n_symvalue) != '\n');
  151.         ;
  152. }
  153.